#lang sicp
(define (make-table)
  (define (make-table data-set) (cons 'table data-set))
  (define (empty-table? t) (empty-data-set? (cdr t)))
  (define (set-table-data-set! table data-set)
    (set-cdr! table data-set))
  (define (data-set-table t) (cdr t))

  (define (make-data-set) '())
  (define (empty-data-set? d) (null? d))
  (define (insert-data-set set data)
    (cons data set))
  (define (find-data-set data-set key)
    (cond ((empty-data-set? data-set) #f)
          ((equal? key (key-data (car data-set))) (car data-set))
          (else
           (find-data-set (cdr data-set) key))))

         
  (define (make-data key record sub-table)
    (list key record sub-table))
  (define (key-data data) (car data))
  (define (record-data data) (cadr data))
  (define (sub-table-data data) (caddr data))
  (define (set-record-data! new-value data)
    (set-car! (cdr data) new-value))

  (define (last-keys? keys) (null? (cdr keys)))
  (define (create-data keys content)
    (define (iter keys)
      (if (last-keys? keys)
          (make-data (car keys) content (make-table (make-data-set)))
          (let ((data (iter (cdr keys)))
                (data-set (make-data-set)))
            (make-data (car keys) nil (make-table (insert-data-set data-set data))))))
    (iter keys))
  
  (define (put keys content table)
    (define (iter keys t)
      (if (empty-table? t)
          (let ((data-set (make-data-set))
                (data (create-data keys content)))
            (set-table-data-set! t (insert-data-set data-set data)))
          (let ((key (car keys))
                (data-set (data-set-table t)))
            (let ((data (find-data-set data-set key)))
              (if data
                  (if (last-keys? keys)
                      (set-record-data! content data)
                      (iter (cdr keys) (sub-table-data data)))
                  (let ((data (create-data keys content)))
                    (set-table-data-set! t (insert-data-set data-set data))))))))
    (iter keys table))

  (define (get keys table)
    (let ((key (car keys))
          (data-set (data-set-table table)))
      (if (empty-data-set? data-set)
          #f
          (let ((data (find-data-set data-set key)))
            (if data
                (if (last-keys? keys)
                    data
                    (get (cdr keys) (sub-table-data data)))
                #f)))))

  
  (let ((table (make-table nil)))
    (define (dispatch m)
      (cond ((eq? m 'put)
             (lambda (op types proc)
               (put (list op types) proc table)))
            ((eq? m 'get)
             (lambda (op types)
               (let ((data (get (list op types) table)))
                 (if data
                     (record-data data)
                     #F))))
            (else
             (error "unknowed operation -- MAKE-TABLE" m))))
    dispatch))

;; main
(define arithmetic-table (make-table))
(define get (arithmetic-table 'get))
(define put (arithmetic-table 'put))


(define coercion-table (make-table))
(define get-coercion (coercion-table 'get))
(define put-coercion (coercion-table 'put))


(define (get-type x)
  (if (number? x)
      'number
      (car x)))
(define (get-content x)
  (if (number? x)
      x
      (cdr x)))
(define (attach-type type x) (cons type x))
(define (square x) (mul x x))


(define (apply-generic op . args)
  (define (try-raise-type)
    (let ((highest-type (find-highest-type (map get-type args))))
      (let ((new-args (raise-all-to-type highest-type args)))
        (let ((types (map get-type new-args))
              (contents (map get-content new-args)))
          (let ((proc (get op types)))
            (if proc
                (apply proc contents)
                (error "No method for these types -- APPLY-GENERIC" (list op types))))))))
  (define (run)
    (let ((types (map get-type args))
        (contents (map get-content args)))
    (let ((proc (get op types)))
      (if proc
          (apply proc contents)
          (if (all-equal? types)
              (error "No method for these types -- APPLY-GENERIC" (list op types args))
              (try-raise-type))))))
  (drop (run)))


(define (all-equal? se)
  (define (iter t se)
    (cond ((null? se) #T)
          ((equal? t (car se)) (iter t (cdr se)))
          (else #F)))
  (if (pair? se)
      (iter (car se) (cdr se))
      (error "Must be pair! -- ALL-EQUAL?" se)))

;; tower structure
(define (make-tower)
  (define data '(tower-bottom))
  (define tower-bottom 'tower-bottom)
  (define (join-supertype subtype supertype)
    (define (join se)
      (cond ((null? se) (error "the subtype given don't found! -- JOIN-SUPERTYPE" subtype))
            ((eq? (car se) subtype)
             (set-cdr! se (cons supertype (cdr se))))
            (else
             (join (cdr se)))))
    (join data))
  (define (get-type-level type)
    (define (iter se n)
      (cond ((null? se) (error "No this type in the tower" type))
            ((eq? (car se) type) n)
            (else (iter (cdr se) (+ 1 n)))))
    (iter data 0))
  (define (dispatch m)
    (cond ((eq? m 'get-type-level) get-type-level)
          ((eq? m 'join-supertype) join-supertype)
          ((eq? m 'tower-bottom) tower-bottom)
          (else
           (error "unknown method! -- MAKE-TOWER" m))))
  dispatch)
(define (raise o)
  (let ((type (get-type o))
        (content (get-content o)))
    (let ((proc (get 'raise type)))
      (if proc
          (proc o)
          (error "Don't raise -- RAISE" type)))))
(define (project o)
  (let ((p (get 'project (get-type o))))
    (if p
        (p o)
        #F)))
(define (drop o)
  (define (iter o)
    (let ((p (project o)))
      (if p
          (let ((res (raise-to-type (get-type o) p)))
            (if (equ? res o)
                (let ((next-drop-res (iter p)))
                  (if next-drop-res
                      next-drop-res
                      p))
                #F))
          #F)))
  (if (tower-number-type? o)
      (let ((res (iter o)))
        (if res
            res
            o))
      o))
(define (tower-number-type? o)
  (or (number? o) (pair? o)))
(define (find-highest-type types)
  (if (list-length-eq types 1)
      (car types)
      (accumulate (lambda (type other)
                    (let ((l1 (tower-type-level type))
                          (l2 (tower-type-level other)))
                      (if (> l1 l2)
                          type
                          other)))
                  (cdr types)
                  (car types))))


(define (raise-to-type type o)
  (if (eq? type (get-type o))
      o
      (raise-to-type type (raise o))))
(define (list-length-eq l n)
  (cond ((null? l)
         (if (= n 0) #T #F))
        ((<= 0) #F)
        (else
         (list-length-eq (cdr l) (- n 1)))))
(define (accumulate combine se init)
  (if (null? se)
      init
      (combine (car se)
               (accumulate combine (cdr se) init))))
(define (raise-all-to-type highest-type args)
  (map (lambda (cur)
         (if (eq? (get-type cur) highest-type)
             cur
             (raise-to-type highest-type cur)))
       args))

;; install tower raise
(define (install-tower-raise)
  (define (number-to-rational number)
    (make-rational number 1))
  (define (real-to-complex real)
    (make-from-real-imag (get-content real) 0))
  (define (rational-to-real rat)
    (make-real (/ (numer rat) (denom rat))))
  (define (complex-to-poly complex)
    (make-poly nil (adjoin-term (make-term 0 complex) (make-sparse-term-list))))

  (put 'raise 'number number-to-rational)
  (put 'raise 'rational rational-to-real)
  (put 'raise 'real real-to-complex)
  (put 'raise 'complex complex-to-poly)
  'done-install-tower-raise
  )
(install-tower-raise)

;; install projection
(define (install-projection)
  (define (project-poly p)
    (get-nth-term-coeff 0 p))
  (define (project-complex c) (real-part c))
  (define (project-real real)
    (round (get-content real)))
  (define (project-rational r)
    (numer r))

  (put 'project 'poly project-poly)
  (put 'project 'complex project-complex)
  (put 'project 'real project-real)
  (put 'project 'rational project-rational)
  'done-install-projection)
(install-projection)


;; create tower
(define tower-type (make-tower))
(define tower-type-level (tower-type 'get-type-level))
(define (tower-join-supertype subtype supertype)
  ((tower-type 'join-supertype) subtype supertype))
(define tower-bottom (tower-type 'tower-bottom))

(tower-join-supertype tower-bottom 'number)
(tower-join-supertype 'number 'rational)
(tower-join-supertype 'rational 'real)
(tower-join-supertype 'real 'complex)
(tower-join-supertype 'complex 'poly)



;; generic arithmetic operation
(define (add a b)
  (apply-generic 'add a b))
(define (sub a b)
  (apply-generic 'sub a b))
(define (mul a b)
  (apply-generic 'mul a b))
(define (div a b)
  (apply-generic 'div a b))
(define (equ? a b)
  (apply-generic 'equ? a b))
(define (=zero? a) (apply-generic '=zero? a))
(define (negation x) (apply-generic 'negation x))
(define (exp b e) (apply-generic 'exp b e))
(define (cosine n) (apply-generic 'cosine n))
(define (sine n) (apply-generic 'sine n))
(define (squareroot n) (apply-generic 'squareroot n))
(define (arctan a b) (apply-generic 'arctan a b))

(define (make-from-real-imag r i)
  ((get 'make-from-real-imag 'complex) r i))
(define (make-from-mag-ang m a)
  ((get 'make-from-mag-ang 'complex) m a))
(define (make-rational numer denom)
  ((get 'make-rational 'rational) numer denom))
(define (make-real n)
  ((get 'make-real 'real) n))


(define (real-part x)
  (apply-generic 'real-part x))
(define (imag-part x)
  (apply-generic 'imag-part x))
(define (magnitude x)
  (apply-generic 'magnitude x))
(define (angle x)
  (apply-generic 'angle x))

(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)


(define (numer rat)
  (apply-generic 'numer rat))
(define (denom rat)
  (apply-generic 'denom rat))


(define (make-poly var term-list)
  ((get 'make-poly 'poly) var term-list))
(define (make-term order coeff)
  ((get 'make-term 'term) order coeff))
(define (make-sparse-term-list)
  ((get 'make-term-list 'sparse)))
(define (make-dense-term-list)
  ((get 'make-term-list 'dense)))

(define (get-nth-term-coeff n poly)
  ((get 'get-nth-term-coeff '(poly)) n (get-content poly)))
(define (get-nth-term n poly)
  ((get 'get-nth-term '(poly)) n (get-content poly)))

(define (adjoin-term term term-list)
  ((get 'adjoin-term (get-type term-list)) term (get-content term-list)))
(define (empty-term-list? term-list)
  (apply-generic 'empty-term-list? term-list))
(define (first-term term-list)
  (apply-generic 'first-term term-list))
(define (rest-terms term-list)
  (apply-generic 'rest-terms term-list))

;; install complex arithmetic package
(define (install-complex-arithmetic-package)
  (define (add-complex z1 z2)
    (make-from-real-imag (add (real-part z1) (real-part z2))
                         (add (imag-part z1) (imag-part z2))))
  (define (sub-complex z1 z2)
    (make-from-real-imag (sub (real-part z1) (real-part z2))
                         (sub (imag-part z1) (imag-part z2))))
  (define (mul-complex z1 z2)
    (make-from-mag-ang (mul (magnitude z1) (magnitude z2))
                       (add (angle z1) (angle z2))))
  (define (div-complex z1 z2)
    (make-from-mag-ang (div (magnitude z1) (magnitude z2))
                       (sub (angle z1) (angle z2))))
  (define (equ-complex? z1 z2)
    (and (equ? (real-part z1) (real-part z2))
         (equ? (imag-part z1) (imag-part z2))))
  (define (=zero? z)
    (and (equ? (real-part z) 0) (equ? (imag-part z) 0)))
  (define (nega z)
    (make-from-real-imag (negation (real-part z))
                         (negation (imag-part z))))
  
  
  (define (make-from-mag-ang m a)
    (attach-type 'polar ((get 'make-from-mag-ang '(polar)) m a)))
  (define (make-from-real-imag m a)
    (attach-type 'rectangular ((get 'make-from-real-imag '(rectangular)) m a)))


  ;; install sub package
  (define (install-complex-polar)
    (define (real-part z) (mul (magnitude z) (cosine (angle z))))
    (define (imag-part z) (mul (magnitude z) (sine (angle z))))
    (define (magnitude z) (car z))
    (define (angle z) (cdr z))
    (define (make-from-real-imag x y)
      (cons (squareroot (add (square x) (square y)))
            (arctan y x)))
    (define (make-from-mag-ang r a) (cons r a))

    ;; install
    (define type 'polar)
    (define set (lambda (op type proc)
                  (put op (list type) proc)))
    (set 'real-part type real-part)
    (set 'imag-part type imag-part)
    (set 'magnitude type magnitude)
    (set 'angle type angle)
    (set 'make-from-real-imag type make-from-real-imag)
    (set 'make-from-mag-ang type make-from-mag-ang)
    'done--install-complex-polar)

  (define (install-complex-rectangular)
    (define (real-part z) (car z))
    (define (imag-part z) (cdr z))
    (define (magnitude z)
      (squareroot (add (square (real-part z))
               (square (imag-part z)))))
    (define (angle z)
      (arctan (imag-part z) (real-part z)))
    (define (make-from-real-imag x y) (cons x y))
    (define (make-from-mag-ang r a)
      (cons (mul r (cosine a)) (mul r (sine a))))

    ;;install
    (define type 'rectangular)
    (define set (lambda (op type proc)
                  (put op (list type) proc)))
    (set 'real-part type real-part)
    (set 'imag-part type imag-part)
    (set 'magnitude type magnitude)
    (set 'angle type angle)
    (set 'make-from-real-imag type make-from-real-imag)
    (set 'make-from-mag-ang type make-from-mag-ang)
    'done--install-complex-rectangular)
  (install-complex-rectangular)
  (install-complex-polar)

  
  (define (tag content) (attach-type 'complex content))
  (put 'add '(complex complex)
       (lambda (x y) (tag (add-complex x y))))
  (put 'sub '(complex complex)
       (lambda (x y) (tag (sub-complex x y))))
  (put 'mul '(complex complex)
       (lambda (x y) (tag (mul-complex x y))))
  (put 'div '(complex complex)
       (lambda (x y) (tag (div-complex x y))))
  (put 'make-from-real-imag 'complex
       (lambda (r i)
         (tag (make-from-real-imag r i))))
  (put 'make-from-mag-ang 'complex
       (lambda (m a)
         (tag (make-from-mag-ang m a))))
  (put 'equ? '(complex complex) equ-complex?)
  (put '=zero? '(complex) =zero?)
  (put 'negation '(complex) (lambda (z) (tag (nega z))))
  'done--install-complex-arithmetic-package
)

(install-complex-arithmetic-package)





;; install common number arithmetic
(define (install-number-arithmetic-package)
  (put 'add '(number number) +)
  (put 'sub '(number number) -)
  (put 'div '(number number) (lambda (a b) (div (make-real a) (make-real b))))
  (put 'mul '(number number) *)
  (put 'equ? '(number number) =)
  (put '=zero? '(number) (lambda (x) (= x 0)))
  (put 'negation '(number) -)
  (put 'exp '(number number) expt)
  (put 'sine '(number) (lambda (x) (sine (make-real x))))
  (put 'cosine '(number) (lambda (x) (cosine (make-real x))))
  (put 'arctan '(number number) (lambda (x y) (arctan (make-real x) (make-real y))))
  (put 'squareroot '(number) (lambda (x) (squareroot (make-real x))))
  'done-install-number-arithmetic-package)

(install-number-arithmetic-package)



;; install real number arithmetic
(define (install-real-arithmetic-package)
  (define (tag x) (attach-type 'real x))
  (put 'add '(real real) (lambda (x y) (tag (+ x y))))
  (put 'sub '(real real) (lambda (x y) (tag (- x y))))
  (put 'div '(real real) (lambda (x y) (tag (/ x y))))
  (put 'mul '(real real) (lambda (x y) (tag (* x y))))
  (put 'sine '(real) (lambda (x) (tag (sin x))))
  (put 'cosine '(real) (lambda (x) (tag (cos x))))
  (put 'squareroot '(real) (lambda (x) (tag (sqrt x))))
  (put 'arctan '(real real) (lambda (x y) (tag (atan x y))))
  (put 'equ? '(real real) =)
  (put '=zero? '(real) (lambda (x) (= x 0)))
  (put 'negation '(real) (lambda (r) (tag (- r))))
  (put 'exp '(real real) expt)
  (put 'make-real 'real (lambda (n) (tag (add n 0.0))))
  'done-install-real-number-arithmetic-package)
(install-real-arithmetic-package)

;; install rational arithmetic
(define (install-rational-arithmetic-package)
  (define (add-rat x y)
    (make-rat (+ (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (sub-rat x y)
    (make-rat (- (* (numer x) (denom y))
                 (* (numer y) (denom x)))
              (* (denom x) (denom y))))
  (define (mul-rat x y)
    (make-rat (* (numer x) (numer y))
              (* (denom x) (denom y))))
  (define (div-rat x y)
    (make-rat (* (numer x) (denom y))
              (* (denom x) (numer y))))
  (define (sine-rat x)
    (sine (to-real x)))
  (define (cosine-rat x)
    (cosine (to-real x)))
  (define (equa-rat? x y)
    (= (* (numer x) (denom y))
       (* (numer y) (denom x))))
  (define (=zero? x)
    (= (numer x) 0))
  (define (nega-rat x)
    (make-rat (negation (numer x))
              (denom x)))
  (define (to-real rat)
    (div (make-real (numer rat))
         (make-real (denom rat))))
  
  (define (make-rat n d)
    (let ((g (gcd n d)))
      (cons (/ n g) (/ d g))))
  (define (numer x) (car x))
  (define (denom x) (cdr x))

  ;; install
  (define (tag x) (attach-type 'rational x))
  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat x y))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat x y))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat x y))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat x y))))
  (put 'sine '(rational)(lambda (x) (sine-rat x)))
  (put 'cosine '(rational) (lambda (x) (cosine-rat x)))
  (put 'squareroot '(rational) (lambda (x) (squareroot (to-real x))))
  (put 'arctan '(rational rational) (lambda (x y) (arctan (to-real x) (to-real y))))
  (put 'make-rational 'rational
       (lambda (numer denom)
         (tag (make-rat numer denom))))
  (put 'equ? '(rational rational) equa-rat?)
  (put '=zero? '(rational) =zero?)
  (put 'negation '(rational) (lambda (x) (tag (nega-rat x))))
  (put 'numer '(rational) numer)
  (put 'denom '(rational) denom)
  'done-install-rational-arithmetic-package)

(install-rational-arithmetic-package)




;; install coercion
(put-coercion 'number 'complex
              (lambda (n)
                (make-from-real-imag n 0)))
(put-coercion 'number 'rational
              (lambda (n)
                (make-rational n 1)))


;; install polynomial package
(define (install-polynomial-package)
  (define (same-variable? v1 v2)
    (or (same-symbol? v1 v2)
        (or (null? v1) (null? v2))))
  
  (define (add-poly p1 p2)
    (if (same-variable? (poly-var p1)
                        (poly-var p2))
        (make-poly (poly-var p1)
                   (add-term-list (poly-term-list p1)
                                  (poly-term-list p2)))
        (error "Both variables is not same!" (list p1 p2))))

  (define (mul-poly p1 p2)
    (if (or (=zero-poly? p1) (=zero-poly? p2))
        (make-empty-poly)
        (let ((var1 (poly-var p1))
              (var2 (poly-var p2))
              (term-list1 (poly-term-list p1))
              (term-list2 (poly-term-list p2)))
          (if (same-variable? var1 var2)
              (make-poly var1
                         (accumulate-term-list (lambda (cur rest)
                                                 (add-term-list rest
                                                                (mul-term-by-term-list cur term-list2)))
                                               term-list1
                                               (make-sparse-term-list)))
              (error "Both variables is not same!")))))

  (define (sub-poly p1 p2)
    (add-poly p1 (negation-poly p2)))

  (define (div-poly p1 p2)
    (if (=zero-poly? p2)
        (error "divisor is zero! -- DIV-POLY" p2)
        (let ((var1 (poly-var p1))
              (var2 (poly-var p2))
              (term-list1 (poly-term-list p1))
              (term-list2 (poly-term-list p2)))
          (if (same-variable? var1 var2)
              (make-poly var1 (div-term-list term-list1 term-list2))
              (error "Both variables is not same! -- DIV-POLY")))))

  (define (=zero-poly? poly)
    (empty-term-list? (poly-term-list poly)))
  
  (define (negation-poly poly)
    (make-poly (poly-var poly)
               (map-term-list negation-term (poly-term-list poly))))


  (define (equ-poly? p1 p2)
    (equ-term-list? (poly-term-list p1)
                    (poly-term-list p2)))


  (define (equ-term-list? l1 l2)
    (define (iter l1 l2)
      (if (and (empty-term-list? l1)
               (empty-term-list? l2))
          #T
          (let ((t1 (first-term l1))
                (t2 (first-term l2)))
            (let ((o1 (term-order t1))
                  (o2 (term-order t2))
                  (c1 (term-coeff t1))
                  (c2 (term-coeff t2)))
              (cond ((= o1 o2)
                     (if (equ? c1 c2)
                         (iter (rest-terms l1) (rest-terms l2))
                         #F))
                    ((< o1 o2)
                     (if (equ? c2 0)
                         (iter l1 (rest-terms l2))
                         #F))
                    (else
                     (if (equ? c1 0)
                         (iter (rest-terms l1) l2)
                         #F)))))))
    (iter l1 l2))


  ;; result < 0  is  o1 < o2
  (define (order-compare o1 o2)
    (- o1 o2))
  
  
  (define (add-term-list tl1 tl2)
    (cond ((empty-term-list? tl1) tl2)
          ((empty-term-list? tl2) tl1)
          (else
           (let ((term1 (first-term tl1))
                 (term2 (first-term tl2))
                 (rest-tl1 (rest-terms tl1))
                 (rest-tl2 (rest-terms tl2)))
             (let ((order1 (term-order term1))
                   (order2 (term-order term2)))
               (cond ((= 0 (order-compare order1 order2))
                      (adjoin-term (add-term term1 term2)
                                   (add-term-list rest-tl1 rest-tl2)))
                     ((> (order-compare order1 order2) 0)
                      (adjoin-term term1
                                   (add-term-list rest-tl1 tl2)))
                     (else
                      (adjoin-term term2
                                   (add-term-list tl1 rest-tl2)))))))))

  (define (mul-term-by-term-list term term-list)
    (map-term-list (lambda (cur)
                     (mul-term cur term))
                   term-list))

  (define (div-term-list l1 l2)
    (if (empty-term-list? l1)
        (list (make-sparse-term-list) (make-sparse-term-list))
        (let ((t1 (first-term l1))
              (t2 (first-term l2)))
          (if (> (term-order t2) (term-order t1))
              (list (make-sparse-term-list) l1)
              (let ((new-coeff (div (term-coeff t1) (term-coeff t2)))
                    (new-order (sub (term-order t1) (term-order t2))))
                (let ((new-poly (make-poly 'x
                                           (adjoin-term (make-term new-order new-coeff)
                                                        (make-sparse-term-list)))))
                  (let ((rest-of-result
                         (div-term-list
                          (poly-term-list
                           (sub-poly (make-poly 'x l1)
                                     (mul-poly new-poly (make-poly 'x l2))))
                          l2)))
                    (let ((quotient (car rest-of-result))
                          (remainder (cadr rest-of-result)))
                      (list (poly-term-list
                             (add-poly new-poly (make-poly 'x quotient)))
                            remainder)))))))))

  
  

  (define (accumulate-term-list combine tl init)
    (if (empty-term-list? tl)
        init
        (combine (first-term tl)
                 (accumulate-term-list combine (rest-terms tl) init))))
  (define (map-term-list proc tl)
    (if (empty-term-list? tl)
        tl
        (adjoin-term (proc (first-term tl))
                     (map-term-list proc (rest-terms tl)))))
  
  ;; selector constructor
  (define (make-poly var term-list)
    (list var term-list))
  (define (make-empty-poly)
    (list nil (make-sparse-term-list)))
  (define (poly-var poly)
    (car poly))
  (define (poly-term-list poly)
    (cadr poly))
  (define (get-nth-term-coeff n poly)
    (term-coeff (get-nth-term n poly)))
  (define (get-nth-term n poly)
    (get-nth-term-list n (poly-term-list poly)))


  (define (get-nth-term-list order tl)
    (if (empty-term-list? tl)
        (make-term order 0)
        (let ((term (first-term tl)))
          (let ((c-o (term-order term)))
            (cond ((> order c-o) (make-term order 0))
                  ((< order c-o) (get-nth-term-list order (rest-terms tl)))
                  (else term))))))
  
  (define (make-term  order coeff) (list order coeff))
  (define (term-order term) (car term))
  (define (term-coeff term) (cadr term))
  (define (negation-term term)
    (make-term (term-order term)
               (negation (term-coeff term))))
  (define (mul-term t1 t2)
    (make-term (+ (term-order t1) (term-order t2))               
               (mul (term-coeff t1) (term-coeff t2))))
  (define (add-term t1 t2)
    (make-term (term-order t1)
               (add (term-coeff t1) (term-coeff t2))))
  ;; install sparse type
  (define (install-sparse-term-list)
    (define (first-term term-list) (car term-list))
    (define (rest-terms term-list) (cdr term-list))
    (define (make-term-list) (list))
    (define (empty-term-list? term-list) (null? term-list))
    (define (adjoin-term term term-list)
      (let ((coeff (term-coeff term))
            (order (term-order term)))
        (define (recur tl)
          (if (empty-term-list? tl)
              (cons term tl)
              (let ((cur-order (term-order (first-term tl))))
                (cond ((> order cur-order)
                       (cons term tl))
                      ((< order cur-order)
                       (cons (first-term tl) (recur (rest-terms tl))))
                      (else
                       (cons (add-term term (first-term tl))
                             (rest-terms tl)))))))
      (if (=zero? coeff)
          term-list
          (recur term-list))))
    ;;
    (define (tag x) (attach-type 'sparse x))
    (put 'first-term '(sparse) first-term)
    (put 'rest-terms '(sparse) (lambda (term-list) (tag (rest-terms term-list))))
    (put 'make-term-list 'sparse (lambda () (tag (make-term-list))))
    (put 'empty-term-list? '(sparse) empty-term-list?)
    (put 'adjoin-term 'sparse (lambda (term term-list)
                                (tag (adjoin-term term term-list))))
    'doen-term-list-sparse-type)
  (install-sparse-term-list)

  ;; install dense type
  (define (install-dense-term-list)
    (define (first-term term-list) (make-term (length (cdr term-list))
                                              (car term-list)))
    (define (rest-terms term-list) (cdr term-list))
    (define (make-term-list) (list))
    (define (empty-term-list? term-list) (null? term-list))
    (define (adjoin-term term term-list)
      (if (=zero? (term-coeff term))
          term-list
          (if (empty-term-list? term-list)
              (cons (term-coeff term) (fill-n-list 0 (term-order term)))
              (let ((order (term-order term))
                    (coeff (term-coeff term))
                    (cur-order (term-order (first-term term-list))))
                (define (iter cur-order tl)
                  (if (< order cur-order)
                      (cons (car tl)
                            (iter (- cur-order 1) (cdr tl)))
                      (cons (add coeff (car tl))
                            (cdr tl))))
                (if (> order cur-order)
                    (append (cons coeff (fill-n-list 0 (- (- order cur-order) 1)))
                            term-list)
                    (iter cur-order term-list))))))
      
    ;;
    (define (tag x) (attach-type 'dense x))
    (put 'first-term '(dense) first-term)
    (put 'rest-terms '(dense) (lambda (term-list) (tag (rest-terms term-list))))
    (put 'make-term-list 'dense (lambda () (tag (make-term-list))))
    (put 'empty-term-list? '(dense) empty-term-list?)
    (put 'adjoin-term 'dense (lambda (term term-list)
                                (tag (adjoin-term term term-list))))
    'doen-term-list-dense-type)
  (install-dense-term-list)


  ;; add into table
  (define (tag x) (attach-type 'poly x))
  (put 'add '(poly poly) (lambda (x y) (tag (add-poly x y))))
  (put 'mul '(poly poly) (lambda (x y) (tag (mul-poly x y))))
  (put 'sub '(poly poly) (lambda (x y) (tag (sub-poly x y))))
  (put 'div '(poly poly) (lambda (x y) (tag (div-poly x y))))
  (put 'equ? '(poly poly) equ-poly?)
  (put '=zero? '(poly) =zero-poly?)
  (put 'negation '(poly) (lambda (x) (tag (negation-poly x))))
  (put 'make-poly 'poly (lambda (v tl) (tag (make-poly v tl))))
  (put 'make-term 'term make-term)
  (put 'get-nth-term '(poly) get-nth-term)
  (put 'get-nth-term-coeff '(poly) get-nth-term-coeff)

  'polynomial-arithmetic-package-done)

(install-polynomial-package)


(define (same-symbol? v1 v2)
  (and (symbol? v1)
       (symbol? v2)
       (eq? v1 v2)))


(define (fill-n-list v n)
  (if (= n 0)
      nil
      (cons v (fill-n-list v (- n 1)))))



;; test
(define a 2)
(define b 4)
(define c-a (make-from-real-imag 3 4))
(define c-b (make-from-mag-ang 5 (make-real 0.729)))
(define c-c (make-from-real-imag 3 0))
(define c-cc (make-from-real-imag (make-real 3.5) 0))
(define c-t1 (make-from-real-imag -3 0))
(define c-t2 (make-from-real-imag 2 0))
(define rat-a (make-rational 1 2))
(define rat-b (make-rational 3 4))
(define rat-c (make-rational 2 1))
(define r-a (make-real 3.2))
(define r-b (make-real 1.5))
(define r-c (make-real 4.0))

(define c-d (make-from-real-imag (make-rational 1 2)
                                 (make-rational 3 4)))
(define c-f (make-from-real-imag (make-rational 1 4)
                                 (make-rational 1 10)))
(define c-g (make-from-real-imag (make-real 3.3)
                                 (make-rational 1 2)))




(define (create-sparse-poly var se)
  (make-poly var (create-term-list se make-sparse-term-list)))
(define (create-dense-poly var se)
  (make-poly var (create-term-list se make-dense-term-list)))
(define (create-term-list se make-term-list)
  (define empty-tl (make-term-list))
  (define (iter se)
    (if (null? se)
        empty-tl
        (let ((cur (car se)))
          (adjoin-term (make-term (car cur)
                                  (cadr cur))
                       (iter (cdr se))))))
  (iter se))


(define p1 (create-sparse-poly 'x '((0 3) (2 2))))
(define p2 (create-sparse-poly 'x '((0 2) (1 1) (2 5))))
(define p3 (create-sparse-poly 'x '((5 1) (0 -1))))
(define p4 (create-sparse-poly 'x '((2 1) (0 -1))))

(define div-poly (lambda (x y)
                   ((get 'div '(poly poly)) (get-content x)
                                            (get-content y))))

(define p5 (create-sparse-poly 'x '((0 -3))))

(define pd1 (create-dense-poly 'x '((0 3) (2 2))))
(define pd2 (create-dense-poly 'x '((0 2) (1 1) (2 5))))
